Lo primero que tengo que hacer es importar el dataset que he creado

dataset <- read.csv("C:/Users/jorge/Desktop/Documentos Clase/Universidad/4ºCarrera/1er Cuatrimestre/Inteligencia Artificial/Trabajo Fin de Asignatura/datos.txt", header = TRUE)

Ahora lo que hago es pasarlo a una matriz, quitando tanto el nombre (que no me interesa) como la etiqueta (que no la necesito por ahora)

matriz.pacientes.etiquetas <- dataset[, -1]
matriz.pacientes.datos <- matriz.pacientes.etiquetas[, -25]

Análisis Exploratorio

Primero compruebo que todos los datos tienen un tipo correcto.

sapply(matriz.pacientes.datos, class)
##              edad               sex rel_ctxo_rel_mala   rel_ctxo_trauma 
##         "integer"         "integer"         "integer"         "integer" 
##    rel_ctxo_buena           ed_perm           ed_norm           ed_estr 
##         "integer"         "integer"         "integer"         "integer" 
##          resil_ba          resil_me          resil_al           pen_dic 
##         "integer"         "integer"         "integer"         "integer" 
##            gen_ex              etiq           fil_men           max_min 
##         "integer"         "integer"         "integer"         "integer" 
##          conc_arb          pseu_res               deb           raz_emo 
##         "integer"         "integer"         "integer"         "integer" 
##             inhib             asert             agres            impuls 
##         "integer"         "integer"         "integer"         "integer"

Veo la media de la edad de los pacientes y el rango en el que se mueve

mean(matriz.pacientes.datos[, 1])
## [1] 26.46269
range(matriz.pacientes.datos[, 1])
## [1] 13 52

Finalmente, veo un resúmen de cada columna

summary(matriz.pacientes.datos)
##       edad            sex        rel_ctxo_rel_mala rel_ctxo_trauma 
##  Min.   :13.00   Min.   :0.000   Min.   :0.0000    Min.   :0.0000  
##  1st Qu.:19.50   1st Qu.:0.000   1st Qu.:0.0000    1st Qu.:0.0000  
##  Median :25.00   Median :0.000   Median :0.0000    Median :0.0000  
##  Mean   :26.46   Mean   :0.209   Mean   :0.1343    Mean   :0.3582  
##  3rd Qu.:30.50   3rd Qu.:0.000   3rd Qu.:0.0000    3rd Qu.:1.0000  
##  Max.   :52.00   Max.   :1.000   Max.   :1.0000    Max.   :1.0000  
##  rel_ctxo_buena      ed_perm          ed_norm          ed_estr      
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
##  Median :1.0000   Median :0.0000   Median :0.0000   Median :0.0000  
##  Mean   :0.5075   Mean   :0.2836   Mean   :0.4925   Mean   :0.2239  
##  3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:0.0000  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000  
##     resil_ba         resil_me         resil_al          pen_dic      
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.00000   Min.   :0.0000  
##  1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.00000   1st Qu.:1.0000  
##  Median :1.0000   Median :0.0000   Median :0.00000   Median :1.0000  
##  Mean   :0.5672   Mean   :0.4179   Mean   :0.01493   Mean   :0.8955  
##  3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:0.00000   3rd Qu.:1.0000  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.00000   Max.   :1.0000  
##      gen_ex            etiq           fil_men         max_min      
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.000   Min.   :0.0000  
##  1st Qu.:1.0000   1st Qu.:0.5000   1st Qu.:1.000   1st Qu.:1.0000  
##  Median :1.0000   Median :1.0000   Median :1.000   Median :1.0000  
##  Mean   :0.9552   Mean   :0.7463   Mean   :0.791   Mean   :0.9701  
##  3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.000   3rd Qu.:1.0000  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.000   Max.   :1.0000  
##     conc_arb         pseu_res           deb            raz_emo     
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.000  
##  1st Qu.:1.0000   1st Qu.:0.0000   1st Qu.:1.0000   1st Qu.:1.000  
##  Median :1.0000   Median :1.0000   Median :1.0000   Median :1.000  
##  Mean   :0.9851   Mean   :0.5075   Mean   :0.9403   Mean   :0.791  
##  3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.000  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.000  
##      inhib            asert            agres           impuls      
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.000   Min.   :0.0000  
##  1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.000   1st Qu.:0.0000  
##  Median :1.0000   Median :0.0000   Median :0.000   Median :1.0000  
##  Mean   :0.6567   Mean   :0.1343   Mean   :0.209   Mean   :0.6119  
##  3rd Qu.:1.0000   3rd Qu.:0.0000   3rd Qu.:0.000   3rd Qu.:1.0000  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.000   Max.   :1.0000

Como se puede ver, los datos de los pacientes están muy distanciados, y además su media es muy alta. Así, la media de la edad difiere enormemente del resto de valores de la matriz. Debido a ello, debemos de hacer un preprocesado de los datos del problema.

Antes que este preprocesado,voy a hacer la visualización de algunas relaciones entre variables, de tal manera que podamos ver gráficamente algunos aspectos interesantes:

Visualización de Datos

Ahora voy a sacar un plot para ver la relación entre la edad y el sexo de las personas que están en consulta

plot(matriz.pacientes.datos[,1], matriz.pacientes.datos[,2], xlab="Edad", ylab="Sexo (0 - mujer, 1 - hombre)", main="Edad & Sexo");

Otro plot para ver la correlación entre ser agresivo y ser impulsivo

#install.packages("hexbin")
#install.packages("RColorBrewer")

library(hexbin)
library(RColorBrewer)

rf <- colorRampPalette(rev(brewer.pal(4,'Spectral')))
df <- data.frame(matriz.pacientes.datos[, 23], matriz.pacientes.datos[, 24])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Agresivo", ylab="Impulsivo", main="Agresivo Vs Impulsivo")

Otro plot similar para ver la relación de ser inhibido e impulsivo

df <- data.frame(matriz.pacientes.datos[, 21], matriz.pacientes.datos[, 24])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Inhibido", ylab="Impulsivo", main="Inhibido Vs Impulsivo")

Voy a ver la relación entre el razonamiento emocional (actuar según tus sentimientos) y la impulsividad

df <- data.frame(matriz.pacientes.datos[, 20], matriz.pacientes.datos[, 24])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Razonamiento Emocional", ylab="Impulsivo", main="Razonamiento Emocional Vs Impulsivo")

Ahora quiero sacar una relación entre ser agresivo y ver el grupo en el que están

rf <- colorRampPalette(rev(brewer.pal(4,'Spectral')))
df <- data.frame(matriz.pacientes.datos[, 23], matriz.pacientes.etiquetas[, 25])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Agresivo", ylab="Grupo", main="Agresivo Y Grupo Real")

Voy a hacer lo mismo con la impulsividad

rf <- colorRampPalette(rev(brewer.pal(4,'Spectral')))
df <- data.frame(matriz.pacientes.datos[, 24], matriz.pacientes.etiquetas[, 25])
h <- hexbin(df)
plot(h, colramp=rf, xlab="Impulsivo", ylab="Grupo", main="Impulsivo y Grupo Real")

De estas gráficas estamos obteniendo información realmente interesante antes de la predicción de los datos. He preferido hacer gráficas en 2D porque las gráficas en 3D son mucho más difíciles de interpretar que estas bonitas gráficas en 2D

Vamos a ver la correlación que tienen mis variables

res <- cor(matriz.pacientes.datos[, 1:24], method = "spearman") # Por mi tipo de datos, hacemos la correlación por spearman
options(width = 100)
res.round <- round(res, 2)

Como saca una tabla enorme, lo que voy a hacer es usar una librería que me da una función para sacar de una forma bonita las correlaciones entre las variables.

#install.packages("corrplot")
library(corrplot)
## corrplot 0.84 loaded
corrplot(res.round, method="circle")

Como podemos ver, por ejemplo, resiliencia baja y media tienen una correlación de -1, ya que si hay una no hay la otra y viceversa. Esto pasa igual con las relaciones entre contexto, ya que buena - trauma, trauma - mala, mala - buena tienen que ser inversas.

Como he comentado antes, Lo que voy a hacer ahora es un centrado y escalado de los datos de la matriz. De esta manera, la red neuronal no tendrá ningún valor que destaque especialmente y con ello no dará de inicio más peso a unos valores que a otros, ya que no lo buscamos.

Modelos de Inteligencia Artificial supervisados

Lo primero que hacemos es importar la librería caret

#install.packages("caret")
library(caret)
## Loading required package: lattice
## Loading required package: ggplot2

Ahora hacemos un centrado y escalado de los datos, ya que la edad no sigue el rango del resto de valores, y distorsionaría la predicción

preObjeto <- preProcess(matriz.pacientes.datos, method=c("center", "scale"))  # Quiero hacer un centrado y escalado
matriz.pacientes.datos.centscal <- predict(preObjeto, matriz.pacientes.datos) # Obtengo los valores en la matriz centscal

Ahora vamos a importar la librería nnet, que nos sirve para hacer perceptrones

#install.packages("nnet")
library(nnet)

Ahora lo que hago es coger un conjunto muy grande de los datos para hacer el entrenamiento

conjuntoEntrenamiento <- sample(1:67, 55)

1 NEURONA

Lo que voy a hacer ahora es entrenar la red neuronal con diferente cantidad de neuronas,y voy a ir comparando el resultado…

SIN SOFTMAX

pacientes.1neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=1 )
## # weights:  33
## initial  value 47.182355 
## iter  10 value 31.755750
## iter  20 value 31.048425
## iter  30 value 27.588930
## iter  40 value 27.566098
## iter  50 value 27.526569
## iter  60 value 26.930644
## iter  70 value 26.809751
## iter  80 value 26.753877
## iter  90 value 26.619130
## iter 100 value 26.507872
## final  value 26.507872 
## stopped after 100 iterations

Lo voy a entrenar también con el SOFTMAX = true. Esto optimiza la verosimilitud, no el error cuadrático medio…

CON SOFTMAX

pacientes.1neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=1, softmax = T )
## # weights:  33
## initial  value 76.981902 
## iter  10 value 58.736754
## iter  20 value 51.546651
## iter  30 value 50.312617
## iter  40 value 49.972443
## iter  50 value 49.936217
## iter  60 value 49.931576
## iter  70 value 49.931168
## iter  80 value 49.931064
## iter  90 value 49.931002
## final  value 49.931000 
## converged

Una vez que lo tengo entrenado, lo que voy a hacer es calcular el error tanto en el entrenamiento como en el test de cada uno

pacientes.prediccion.1neu <- predict( pacientes.1neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.1neu # Vemos las probabilidades de pertenencia de cada valor
##            1            2          3          4
## 48 0.2182551 6.944442e-01 0.02182478 0.06547593
## 2  0.2182551 6.944442e-01 0.02182478 0.06547593
## 67 0.2500081 0.000000e+00 0.31249816 0.43749373
## 36 0.2182551 6.944442e-01 0.02182478 0.06547593
## 31 0.2182551 6.944442e-01 0.02182478 0.06547593
## 16 0.2500081 0.000000e+00 0.31249816 0.43749373
## 33 0.2182551 6.944442e-01 0.02182478 0.06547593
## 42 0.7142256 5.541452e-06 0.07144698 0.21432185
## 35 0.2182551 6.944442e-01 0.02182478 0.06547593
## 60 0.2182551 6.944442e-01 0.02182478 0.06547593
## 62 0.2182551 6.944442e-01 0.02182478 0.06547593
## 13 0.2182551 6.944442e-01 0.02182478 0.06547593
## 38 0.2500081 0.000000e+00 0.31249816 0.43749373
## 8  0.2182551 6.944442e-01 0.02182478 0.06547593
## 43 0.2182551 6.944442e-01 0.02182478 0.06547593
## 65 0.2500081 0.000000e+00 0.31249816 0.43749373
## 19 0.2182551 6.944442e-01 0.02182478 0.06547593
## 61 0.2182551 6.944442e-01 0.02182478 0.06547593
## 41 0.2500081 0.000000e+00 0.31249816 0.43749373
## 54 0.2500081 0.000000e+00 0.31249816 0.43749373
## 57 0.2500081 0.000000e+00 0.31249816 0.43749373
## 29 0.2182551 6.944442e-01 0.02182478 0.06547593
## 21 0.2182551 6.944442e-01 0.02182478 0.06547593
## 1  0.2500081 0.000000e+00 0.31249816 0.43749373
## 23 0.2182551 6.944442e-01 0.02182478 0.06547593
## 27 0.2500081 0.000000e+00 0.31249816 0.43749373
## 12 0.2182551 6.944442e-01 0.02182478 0.06547593
## 49 0.2182551 6.944442e-01 0.02182478 0.06547593
## 45 0.2182551 6.944442e-01 0.02182478 0.06547593
## 7  0.2500081 0.000000e+00 0.31249816 0.43749373
## 44 0.2182551 6.944442e-01 0.02182478 0.06547593
## 53 0.2182551 6.944442e-01 0.02182478 0.06547593
## 66 0.2182551 6.944442e-01 0.02182478 0.06547593
## 32 0.2182551 6.944442e-01 0.02182478 0.06547593
## 55 0.7142257 7.116655e-06 0.07144646 0.21432077
## 24 0.2500081 0.000000e+00 0.31249816 0.43749373
## 37 0.2182551 6.944442e-01 0.02182478 0.06547593
## 20 0.2182551 6.944442e-01 0.02182478 0.06547593
## 47 0.2182551 6.944442e-01 0.02182478 0.06547593
## 64 0.2182551 6.944442e-01 0.02182478 0.06547593
## 26 0.2500081 0.000000e+00 0.31249816 0.43749373
## 4  0.2500081 0.000000e+00 0.31249816 0.43749373
## 25 0.7142256 7.233427e-06 0.07144643 0.21432069
## 46 0.2182551 6.944442e-01 0.02182478 0.06547593
## 11 0.2182551 6.944442e-01 0.02182478 0.06547593
## 17 0.2182551 6.944442e-01 0.02182478 0.06547593
## 15 0.2500081 0.000000e+00 0.31249816 0.43749373
## 28 0.2182551 6.944442e-01 0.02182478 0.06547593
## 59 0.2500081 0.000000e+00 0.31249816 0.43749373
## 10 0.2182551 6.944442e-01 0.02182478 0.06547593
## 50 0.2182551 6.944442e-01 0.02182478 0.06547593
## 14 0.2500081 0.000000e+00 0.31249816 0.43749373
## 52 0.2182551 6.944442e-01 0.02182478 0.06547593
## 39 0.2182551 6.944442e-01 0.02182478 0.06547593
## 34 0.2182551 6.944442e-01 0.02182478 0.06547593

Ahora que los tengo todos entrenados, Determinamos cual es la máxima, es decir, la clase a la que hay que asignar los objetos

pacientes.prediccion.1neu.class <- apply( pacientes.prediccion.1neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.1neu.class
## 48  2 67 36 31 16 33 42 35 60 62 13 38  8 43 65 19 61 41 54 57 29 21  1 23 27 12 49 45  7 44 53 66 
##  2  2  4  2  2  4  2  1  2  2  2  2  4  2  2  4  2  2  4  4  4  2  2  4  2  4  2  2  2  4  2  2  2 
## 32 55 24 37 20 47 64 26  4 25 46 11 17 15 28 59 10 50 14 52 39 34 
##  2  1  4  2  2  2  2  4  4  1  2  2  2  4  2  4  2  2  4  2  2  2

Lo visualizo en forma de tabla para ir viendo el error

table( pacientes.prediccion.1neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] )  # Lo vemos en forma de tabla.
##                                
## pacientes.prediccion.1neu.class  1  2  3  4
##                               1  3  0  0  0
##                               2  7 25  1  3
##                               4  4  0  5  7

Calculo el acierto

sum( diag( table( pacientes.prediccion.1neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.6

TEST

pacientes.prediccion.test.1neu <- predict( pacientes.1neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.1neu
##            1         2          3          4
## 3  0.2182551 0.6944442 0.02182478 0.06547593
## 5  0.2182551 0.6944442 0.02182478 0.06547593
## 6  0.2182551 0.6944442 0.02182478 0.06547593
## 9  0.2182551 0.6944442 0.02182478 0.06547593
## 18 0.2182551 0.6944442 0.02182478 0.06547593
## 22 0.2500081 0.0000000 0.31249816 0.43749373
## 30 0.2182551 0.6944442 0.02182478 0.06547593
## 40 0.2182551 0.6944442 0.02182478 0.06547593
## 51 0.2182551 0.6944442 0.02182478 0.06547593
## 56 0.2182551 0.6944442 0.02182478 0.06547593
## 58 0.2500081 0.0000000 0.31249816 0.43749373
## 63 0.2182551 0.6944442 0.02182478 0.06547593
pacientes.prediccion.test.1neu.class <- apply( pacientes.prediccion.test.1neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.1neu.class
##  3  5  6  9 18 22 30 40 51 56 58 63 
##  2  2  2  2  2  4  2  2  2  2  4  2
table( pacientes.prediccion.test.1neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##                                     
## pacientes.prediccion.test.1neu.class 1 2 3 4
##                                    2 2 5 1 2
##                                    4 1 0 1 0
sum( diag( table( pacientes.prediccion.test.1neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.1666667

2 NEURONAS

A partir de ahora voy a hacer exactamente lo mismo, por lo que haré chunks más grandes para evitar una sobrecarga de chunks, y reduciré la cantidad de comentarios, ya que serán redundantes

SIN SOFTMAX

pacientes.2neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=2 )
## # weights:  62
## initial  value 57.171190 
## iter  10 value 36.350469
## iter  20 value 34.470956
## iter  30 value 34.229100
## iter  40 value 34.181727
## iter  50 value 34.111747
## iter  60 value 30.578001
## iter  70 value 28.978521
## iter  80 value 28.938468
## iter  90 value 28.492770
## iter 100 value 28.418537
## final  value 28.418537 
## stopped after 100 iterations

CON SOFTMAX

pacientes.2neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=2, softmax = T )
## # weights:  62
## initial  value 85.713429 
## iter  10 value 46.949297
## iter  20 value 36.315436
## iter  30 value 33.715564
## iter  40 value 33.096086
## iter  50 value 32.671130
## iter  60 value 32.583070
## iter  70 value 32.559594
## iter  80 value 32.555846
## iter  90 value 32.554053
## iter 100 value 32.553744
## final  value 32.553744 
## stopped after 100 iterations

pacientes.prediccion.2neu <- predict( pacientes.2neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.2neu # Vemos las probabilidades de pertenencia de cada valor
##               1            2            3            4
## 48 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 2  7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 67 1.000000e+00 0.0000000000 2.898184e-21 0.000000e+00
## 36 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 31 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 16 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 33 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 42 1.000000e+00 0.0000000000 2.898184e-21 0.000000e+00
## 35 0.000000e+00 0.8573756339 0.000000e+00 1.426244e-01
## 60 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 62 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 13 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 38 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 8  7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 43 1.000000e+00 0.0000000000 2.898184e-21 0.000000e+00
## 65 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 19 0.000000e+00 0.8573756339 0.000000e+00 1.426244e-01
## 61 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 41 6.676024e-01 0.0006174692 3.317458e-01 3.435445e-05
## 54 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 57 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 29 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 21 5.717718e-10 0.9473110383 2.921983e-10 5.268896e-02
## 1  1.000000e+00 0.0000000000 2.898184e-21 0.000000e+00
## 23 1.000000e+00 0.0000000000 2.898184e-21 0.000000e+00
## 27 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 12 1.000000e+00 0.0000000000 2.898184e-21 0.000000e+00
## 49 1.000000e+00 0.0000000000 2.898184e-21 0.000000e+00
## 45 0.000000e+00 0.8573756339 0.000000e+00 1.426244e-01
## 7  1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 44 4.929354e-16 0.9472951256 2.554668e-16 5.270487e-02
## 53 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 66 0.000000e+00 0.8573756339 0.000000e+00 1.426244e-01
## 32 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 55 1.000000e+00 0.0000000000 2.898184e-21 0.000000e+00
## 24 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 37 1.154985e-06 0.9473180617 5.857498e-07 5.268020e-02
## 20 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 47 9.361414e-06 0.1110660967 2.362983e-05 8.889009e-01
## 64 0.000000e+00 0.8573756339 0.000000e+00 1.426244e-01
## 26 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 4  1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 25 1.000000e+00 0.0000000000 2.898184e-21 0.000000e+00
## 46 3.590767e-06 0.9473158782 1.818983e-06 5.267871e-02
## 11 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 17 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 15 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 28 0.000000e+00 0.8573756339 0.000000e+00 1.426244e-01
## 59 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 10 0.000000e+00 0.8573756339 0.000000e+00 1.426244e-01
## 50 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 14 1.333819e-01 0.0591850555 3.333644e-01 4.740686e-01
## 52 1.000000e+00 0.0000000000 2.898184e-21 0.000000e+00
## 39 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
## 34 7.847016e-02 0.8357185917 3.934902e-02 4.646223e-02
pacientes.prediccion.2neu.class <- apply( pacientes.prediccion.2neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.2neu.class
## 48  2 67 36 31 16 33 42 35 60 62 13 38  8 43 65 19 61 41 54 57 29 21  1 23 27 12 49 45  7 44 53 66 
##  2  2  1  2  2  4  2  1  2  2  2  2  4  2  1  4  2  4  1  4  4  2  2  1  1  4  1  1  2  4  2  2  2 
## 32 55 24 37 20 47 64 26  4 25 46 11 17 15 28 59 10 50 14 52 39 34 
##  4  1  4  2  2  4  2  4  4  1  2  2  2  4  2  4  2  2  4  1  2  2
table( pacientes.prediccion.2neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] )  # Lo vemos en forma de tabla.
##                                
## pacientes.prediccion.2neu.class  1  2  3  4
##                               1 10  0  1  0
##                               2  2 24  0  2
##                               4  2  1  5  8
sum( diag( table( pacientes.prediccion.2neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.7090909

TEST

pacientes.prediccion.test.2neu <- predict( pacientes.2neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.2neu
##             1          2            3          4
## 3  0.07847016 0.83571859 3.934902e-02 0.04646223
## 5  0.07847016 0.83571859 3.934902e-02 0.04646223
## 6  0.07847016 0.83571859 3.934902e-02 0.04646223
## 9  0.00000000 0.85737563 0.000000e+00 0.14262437
## 18 1.00000000 0.00000000 2.898184e-21 0.00000000
## 22 0.13338195 0.05918506 3.333644e-01 0.47406856
## 30 0.00000000 0.85737563 0.000000e+00 0.14262437
## 40 0.07847016 0.83571859 3.934902e-02 0.04646223
## 51 1.00000000 0.00000000 2.898184e-21 0.00000000
## 56 0.13338195 0.05918506 3.333644e-01 0.47406856
## 58 0.13338195 0.05918506 3.333644e-01 0.47406856
## 63 0.00000000 0.85737563 0.000000e+00 0.14262437
pacientes.prediccion.test.2neu.class <- apply( pacientes.prediccion.test.2neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.2neu.class
##  3  5  6  9 18 22 30 40 51 56 58 63 
##  2  2  2  2  1  4  2  2  1  4  4  2
table( pacientes.prediccion.test.2neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##                                     
## pacientes.prediccion.test.2neu.class 1 2 3 4
##                                    1 0 1 0 1
##                                    2 1 4 1 1
##                                    4 2 0 1 0
sum( diag( table( pacientes.prediccion.test.2neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.4166667

3 NEURONAS

SIN SOFTMAX

pacientes.3neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3)
## # weights:  91
## initial  value 55.275292 
## iter  10 value 23.491846
## iter  20 value 16.975492
## iter  30 value 14.582436
## iter  40 value 13.481831
## iter  50 value 13.271813
## iter  60 value 13.225876
## iter  70 value 13.211509
## iter  80 value 13.034181
## iter  90 value 13.016839
## iter 100 value 12.998613
## final  value 12.998613 
## stopped after 100 iterations

CON SOFTMAX

pacientes.3neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3, softmax = T)
## # weights:  91
## initial  value 81.267404 
## iter  10 value 39.196441
## iter  20 value 28.165958
## iter  30 value 24.251702
## iter  40 value 23.456258
## iter  50 value 22.301147
## iter  60 value 21.847912
## iter  70 value 21.357770
## iter  80 value 20.597247
## iter  90 value 20.164476
## iter 100 value 19.129781
## final  value 19.129781 
## stopped after 100 iterations

pacientes.prediccion.3neu <- predict( pacientes.3neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.3neu # Vemos las probabilidades de pertenencia de cada valor
##               1            2            3            4
## 48 0.0005479509 0.9994520491 2.064353e-57 3.441319e-11
## 2  0.3629597143 0.6370402857 5.401245e-18 6.616249e-32
## 67 0.9988886180 0.0011113820 3.471656e-18 3.575228e-24
## 36 0.1721432062 0.8249400375 2.916756e-03 6.656585e-29
## 31 0.0334932331 0.9664884431 8.894238e-56 1.832376e-05
## 16 0.0003666769 0.0017920862 4.430738e-40 9.978412e-01
## 33 0.0006809461 0.9993190539 6.269232e-39 4.352858e-13
## 42 0.9989849731 0.0010150269 9.922747e-18 1.837113e-24
## 35 0.1641928479 0.8228066932 1.300046e-02 8.925748e-29
## 60 0.0003867783 0.9996132216 1.316559e-57 1.261167e-11
## 62 0.3537678121 0.5295911384 7.998727e-55 1.166410e-01
## 13 0.3629695800 0.6370304200 5.404058e-18 6.614357e-32
## 38 0.1586645332 0.0005261300 8.408093e-01 2.411607e-21
## 8  0.3629695800 0.6370304200 5.404058e-18 6.614357e-32
## 43 0.9989849781 0.0010150219 9.917347e-18 1.837040e-24
## 65 0.0003666910 0.0017910330 4.438313e-40 9.978423e-01
## 19 0.0001184962 0.9998814718 2.147130e-40 3.199021e-08
## 61 0.3537768757 0.5295747748 7.999742e-55 1.166483e-01
## 41 0.1588745489 0.0005269121 8.405985e-01 2.417771e-21
## 54 0.1589070215 0.0005270327 8.405659e-01 2.418621e-21
## 57 0.0709318187 0.4091448514 5.199233e-01 1.124920e-28
## 29 0.0003891962 0.9996108037 1.320571e-57 1.290849e-11
## 21 0.0001184962 0.9998814718 2.147130e-40 3.199021e-08
## 1  0.0681013072 0.3900412955 5.418574e-01 1.025236e-28
## 23 0.3629695800 0.6370304200 5.404058e-18 6.614357e-32
## 27 0.0008563828 0.0037413472 2.191570e-41 9.954023e-01
## 12 0.9138510147 0.0861489849 1.596760e-40 4.630074e-10
## 49 0.3537724746 0.5295729410 7.998812e-55 1.166546e-01
## 45 0.0001184966 0.9998814714 2.147137e-40 3.199056e-08
## 7  0.0003662974 0.0017893728 4.426038e-40 9.978443e-01
## 44 0.3537867274 0.5295788793 8.001825e-55 1.166344e-01
## 53 0.4755151534 0.5064090521 2.571657e-29 1.807579e-02
## 66 0.0001184962 0.9998814718 2.147130e-40 3.199021e-08
## 32 0.1619258108 0.0005365834 8.375376e-01 2.448457e-21
## 55 0.1584989443 0.0005255385 8.409755e-01 2.407749e-21
## 24 0.3537724746 0.5295729410 7.998812e-55 1.166546e-01
## 37 0.3629695800 0.6370304200 5.404058e-18 6.614357e-32
## 20 0.0035813012 0.9964186988 1.364706e-22 1.271478e-17
## 47 0.0005071144 0.0023698688 9.116517e-40 9.971230e-01
## 64 0.3537724746 0.5295729410 7.998812e-55 1.166546e-01
## 26 0.1401322815 0.0059335768 8.539341e-01 8.608148e-24
## 4  0.0003663557 0.0017896199 4.423552e-40 9.978440e-01
## 25 0.3531360013 0.5320259852 7.987209e-55 1.148380e-01
## 46 0.3537743480 0.5295737216 7.999208e-55 1.166519e-01
## 11 0.0101296554 0.9898699486 2.876471e-56 3.959735e-07
## 17 0.0004064627 0.0019586197 3.063951e-40 9.976349e-01
## 15 0.9989260945 0.0010739055 4.294518e-17 2.462998e-24
## 28 0.0003716608 0.0018122175 4.206316e-40 9.978161e-01
## 59 0.0019978770 0.0077375775 3.539148e-38 9.902645e-01
## 10 0.0001185386 0.9998814294 2.149180e-40 3.201029e-08
## 50 0.1733109855 0.8244157962 2.273218e-03 6.332828e-29
## 14 0.9876977264 0.0058445932 6.457680e-03 1.053112e-18
## 52 0.9989811683 0.0010188317 9.496787e-18 1.888230e-24
## 39 0.0004633630 0.9995366370 1.277644e-56 4.004553e-12
## 34 0.3629695800 0.6370304200 5.404058e-18 6.614357e-32
pacientes.prediccion.3neu.class <- apply( pacientes.prediccion.3neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.3neu.class
## 48  2 67 36 31 16 33 42 35 60 62 13 38  8 43 65 19 61 41 54 57 29 21  1 23 27 12 49 45  7 44 53 66 
##  2  2  1  2  2  4  2  1  2  2  2  2  3  2  1  4  2  2  3  3  3  2  2  3  2  4  1  2  2  4  2  2  2 
## 32 55 24 37 20 47 64 26  4 25 46 11 17 15 28 59 10 50 14 52 39 34 
##  3  3  2  2  2  4  2  3  4  2  2  2  4  1  4  4  2  2  1  1  2  2
table( pacientes.prediccion.3neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] )  # Lo vemos en forma de tabla.
##                                
## pacientes.prediccion.3neu.class  1  2  3  4
##                               1  7  0  0  0
##                               2  5 25  0  1
##                               3  2  0  6  0
##                               4  0  0  0  9
sum( diag( table( pacientes.prediccion.3neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.8545455

TEST

pacientes.prediccion.test.3neu <- predict( pacientes.3neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.3neu
##               1           2            3            4
## 3  0.0681013072 0.390041296 5.418574e-01 1.025236e-28
## 5  0.3628278717 0.637172128 5.363791e-18 6.641584e-32
## 6  0.0001262148 0.999873763 4.551874e-40 2.218362e-08
## 9  0.0135682163 0.830830238 1.881023e-38 1.556015e-01
## 18 0.9989848347 0.001015165 9.901134e-18 1.838948e-24
## 22 0.9989260945 0.001073906 4.294518e-17 2.462998e-24
## 30 0.0767919303 0.364388959 5.588191e-01 1.698231e-28
## 40 0.3551415674 0.530135345 8.294156e-55 1.147231e-01
## 51 0.9989849863 0.001015014 9.918275e-18 1.836930e-24
## 56 0.0003662974 0.001789373 4.426038e-40 9.978443e-01
## 58 0.9988099951 0.001190005 2.414171e-15 6.185205e-24
## 63 0.0002004505 0.999799548 1.588496e-37 1.141387e-09
pacientes.prediccion.test.3neu.class <- apply( pacientes.prediccion.test.3neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.3neu.class
##  3  5  6  9 18 22 30 40 51 56 58 63 
##  3  2  2  2  1  1  3  2  1  4  1  2
table( pacientes.prediccion.test.3neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##                                     
## pacientes.prediccion.test.3neu.class 1 2 3 4
##                                    1 1 1 1 1
##                                    2 1 2 1 1
##                                    3 0 2 0 0
##                                    4 1 0 0 0
sum( diag( table( pacientes.prediccion.test.3neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.25

3 NEURONAS

Con Decay

SIN SOFTMAX

pacientes.3neu.decay <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3, decay = 0.2)
## # weights:  91
## initial  value 63.443887 
## iter  10 value 33.654930
## iter  20 value 32.002612
## iter  30 value 31.566500
## iter  40 value 31.553790
## final  value 31.552825 
## converged

CON SOFTMAX

pacientes.3neu.decay <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=3, softmax = T, decay = 0.03)
## # weights:  91
## initial  value 87.997388 
## iter  10 value 48.183944
## iter  20 value 38.250394
## iter  30 value 33.925167
## iter  40 value 31.454872
## iter  50 value 29.463919
## iter  60 value 27.930583
## iter  70 value 27.805877
## iter  80 value 27.312382
## iter  90 value 27.023265
## iter 100 value 26.806385
## final  value 26.806385 
## stopped after 100 iterations

pacientes.prediccion.3neu.decay <- predict( pacientes.3neu.decay, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.3neu.decay # Vemos las probabilidades de pertenencia de cada valor
##              1            2            3            4
## 48 0.040205928 7.415492e-01 2.178930e-01 3.518992e-04
## 2  0.002017868 9.979405e-01 4.141604e-05 2.414128e-07
## 67 0.500158535 3.263459e-01 3.854390e-02 1.349516e-01
## 36 0.056596971 9.321122e-01 1.118231e-02 1.085041e-04
## 31 0.017920286 9.818386e-01 2.213553e-04 1.977661e-05
## 16 0.037690949 2.823463e-05 2.741925e-02 9.348616e-01
## 33 0.001830466 9.981303e-01 3.903567e-05 1.971087e-07
## 42 0.809210045 1.395956e-01 3.712904e-02 1.406531e-02
## 35 0.019079619 9.752386e-01 5.644731e-03 3.705999e-05
## 60 0.032603611 9.649973e-01 2.326131e-03 7.297551e-05
## 62 0.518486214 3.096162e-01 2.519995e-02 1.466977e-01
## 13 0.023023550 9.766434e-01 3.242120e-04 8.840590e-06
## 38 0.356247974 1.005809e-02 5.603843e-01 7.330962e-02
## 8  0.355715445 6.396305e-01 3.915657e-03 7.383567e-04
## 43 0.764918702 3.836757e-02 5.772287e-02 1.389909e-01
## 65 0.047293635 2.140457e-05 1.977779e-02 9.329072e-01
## 19 0.005898241 9.937929e-01 3.065666e-04 2.284116e-06
## 61 0.663980886 3.278880e-01 5.289432e-03 2.841646e-03
## 41 0.216401227 1.718911e-01 5.422730e-01 6.943466e-02
## 54 0.240875299 5.083007e-02 6.897810e-01 1.851367e-02
## 57 0.256066280 7.178704e-02 6.582400e-01 1.390673e-02
## 29 0.005849718 9.930956e-01 1.051622e-03 3.044584e-06
## 21 0.013044198 9.866806e-01 2.623405e-04 1.283507e-05
## 1  0.512990612 2.505278e-01 4.229400e-02 1.941876e-01
## 23 0.898902553 5.430118e-02 3.607314e-03 4.318896e-02
## 27 0.010838756 1.278993e-06 4.276476e-03 9.848835e-01
## 12 0.839628432 9.533808e-02 3.488863e-03 6.154462e-02
## 49 0.645049236 3.475514e-01 4.912934e-03 2.486421e-03
## 45 0.022304758 9.213473e-01 5.627361e-02 7.433341e-05
## 7  0.073997165 2.429212e-04 7.376550e-02 8.519944e-01
## 44 0.472249014 4.685635e-01 2.416273e-03 5.677126e-02
## 53 0.047309986 6.879469e-01 2.642252e-01 5.178685e-04
## 66 0.010483438 9.892325e-01 2.805202e-04 3.552125e-06
## 32 0.243704909 1.594737e-02 3.367809e-01 4.035668e-01
## 55 0.228358077 1.020990e-01 5.295978e-01 1.399452e-01
## 24 0.341924889 7.012967e-04 6.067329e-04 6.567671e-01
## 37 0.103745345 8.943984e-01 1.750702e-03 1.055500e-04
## 20 0.003141348 9.966886e-01 1.693507e-04 6.981534e-07
## 47 0.226461595 2.100633e-03 1.943901e-01 5.770477e-01
## 64 0.018830798 9.789484e-01 2.196450e-03 2.439582e-05
## 26 0.243686893 1.686094e-01 4.987554e-01 8.894826e-02
## 4  0.039526540 1.515262e-05 1.674475e-02 9.437136e-01
## 25 0.887936070 4.790422e-02 3.385123e-03 6.077459e-02
## 46 0.148492880 8.430181e-01 5.901223e-03 2.587764e-03
## 11 0.234256294 7.581699e-01 1.478018e-03 6.095740e-03
## 17 0.240505616 2.821327e-02 1.479910e-01 5.832902e-01
## 15 0.769732669 1.506476e-01 6.667424e-02 1.294550e-02
## 28 0.121765157 7.287118e-03 1.715704e-01 6.993774e-01
## 59 0.006880148 5.565757e-07 3.400670e-03 9.897186e-01
## 10 0.024665907 9.602236e-01 1.504631e-02 6.422778e-05
## 50 0.012235305 9.777687e-01 9.978146e-03 1.789148e-05
## 14 0.301412795 3.295269e-03 5.111943e-01 1.840976e-01
## 52 0.764243935 1.932409e-01 3.362681e-02 8.888400e-03
## 39 0.010516995 9.828896e-01 6.581259e-03 1.216449e-05
## 34 0.422285440 5.724329e-01 4.286539e-03 9.951233e-04
pacientes.prediccion.3neu.class.decay <- apply( pacientes.prediccion.3neu.decay, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.3neu.class.decay
## 48  2 67 36 31 16 33 42 35 60 62 13 38  8 43 65 19 61 41 54 57 29 21  1 23 27 12 49 45  7 44 53 66 
##  2  2  1  2  2  4  2  1  2  2  1  2  3  2  1  4  2  1  3  3  3  2  2  1  1  4  1  1  2  4  1  2  2 
## 32 55 24 37 20 47 64 26  4 25 46 11 17 15 28 59 10 50 14 52 39 34 
##  4  3  4  2  2  4  2  3  4  1  2  2  4  1  4  4  2  2  3  1  2  2
table( pacientes.prediccion.3neu.class.decay, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] )  # Lo vemos en forma de tabla.
##                                      
## pacientes.prediccion.3neu.class.decay  1  2  3  4
##                                     1 11  2  0  0
##                                     2  1 23  0  0
##                                     3  2  0  5  0
##                                     4  0  0  1 10
sum( diag( table( pacientes.prediccion.3neu.class.decay, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.8909091

TEST

pacientes.prediccion.test.3neu.decay <- predict( pacientes.3neu.decay, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.3neu.decay
##              1           2            3            4
## 3  0.008046516 0.989140468 0.0028064871 6.528660e-06
## 5  0.015304486 0.962706154 0.0219581861 3.117391e-05
## 6  0.354403585 0.071269117 0.1404116381 4.339157e-01
## 9  0.036587907 0.745134681 0.2179854761 2.919366e-04
## 18 0.078250062 0.920694798 0.0009840481 7.109203e-05
## 22 0.769732669 0.150647589 0.0666742376 1.294550e-02
## 30 0.024899151 0.864578908 0.1104098659 1.120752e-04
## 40 0.480725553 0.504285878 0.0026998235 1.228875e-02
## 51 0.622093491 0.370838476 0.0049219953 2.146038e-03
## 56 0.584461413 0.009094868 0.2069144401 1.995293e-01
## 58 0.503861545 0.419420711 0.0037436714 7.297407e-02
## 63 0.665719517 0.320022493 0.0108422358 3.415753e-03
pacientes.prediccion.test.3neu.class.decay <- apply( pacientes.prediccion.test.3neu.decay, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.3neu.class.decay
##  3  5  6  9 18 22 30 40 51 56 58 63 
##  2  2  4  2  2  1  2  2  1  1  1  1
table( pacientes.prediccion.test.3neu.class.decay , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##                                           
## pacientes.prediccion.test.3neu.class.decay 1 2 3 4
##                                          1 2 0 2 1
##                                          2 1 5 0 0
##                                          4 0 0 0 1
sum( diag( table( pacientes.prediccion.test.3neu.class.decay, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.5833333

5 NEURONAS

SIN SOFTMAX

pacientes.5neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5 )
## # weights:  149
## initial  value 62.452809 
## iter  10 value 35.811900
## iter  20 value 32.808001
## iter  30 value 32.082116
## iter  40 value 31.726210
## iter  50 value 31.671178
## iter  60 value 31.668844
## iter  70 value 31.667401
## iter  80 value 31.667248
## iter  90 value 31.666804
## iter 100 value 31.666769
## final  value 31.666769 
## stopped after 100 iterations

CON SOFTMAX

pacientes.5neu <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5, softmax = T )
## # weights:  149
## initial  value 99.191916 
## iter  10 value 31.757271
## iter  20 value 11.599548
## iter  30 value 8.583839
## iter  40 value 8.571136
## iter  50 value 8.570516
## final  value 8.570461 
## converged

pacientes.prediccion.5neu <- predict( pacientes.5neu, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.5neu # Vemos las probabilidades de pertenencia de cada valor
##               1            2            3            4
## 48 6.471408e-08 9.999999e-01 1.346135e-26 9.261498e-21
## 2  1.923752e-20 1.000000e+00 3.649458e-34 1.038548e-40
## 67 1.000000e+00 1.564011e-17 3.468628e-20 2.391284e-40
## 36 2.500126e-01 7.499874e-01 3.723388e-17 1.051388e-51
## 31 1.773496e-08 1.000000e+00 6.776867e-25 1.817868e-09
## 16 5.671546e-21 4.059967e-22 1.806061e-19 1.000000e+00
## 33 1.923752e-20 1.000000e+00 3.649458e-34 1.038548e-40
## 42 6.666929e-01 3.333065e-01 6.346580e-09 5.780184e-07
## 35 1.928103e-20 1.000000e+00 3.683664e-34 1.034682e-40
## 60 1.415140e-27 1.000000e+00 2.711032e-51 4.150893e-22
## 62 3.333657e-01 6.666343e-01 1.957835e-23 1.698048e-12
## 13 9.930810e-16 1.000000e+00 1.619965e-31 8.087686e-34
## 38 8.000045e-01 3.304870e-21 1.999955e-01 1.098789e-10
## 8  2.500126e-01 7.499874e-01 3.723388e-17 1.051388e-51
## 43 1.000000e+00 1.154005e-19 4.610543e-25 3.967826e-42
## 65 3.328968e-26 5.959840e-28 1.716409e-10 1.000000e+00
## 19 5.373964e-19 9.999999e-01 5.527768e-09 1.004250e-07
## 61 6.666929e-01 3.333065e-01 6.346580e-09 5.780184e-07
## 41 5.997717e-25 2.790245e-07 9.999997e-01 1.907742e-08
## 54 1.238363e-08 1.329824e-09 1.000000e+00 1.802678e-27
## 57 1.280348e-08 1.377706e-09 1.000000e+00 1.783021e-27
## 29 1.415140e-27 1.000000e+00 2.711032e-51 4.150893e-22
## 21 4.440572e-39 1.000000e+00 1.739322e-36 5.238172e-24
## 1  8.000045e-01 3.304870e-21 1.999955e-01 1.098789e-10
## 23 1.000000e+00 6.274892e-12 2.872428e-49 1.266573e-21
## 27 2.283765e-11 5.127480e-24 3.562271e-36 1.000000e+00
## 12 1.000000e+00 1.154005e-19 4.610543e-25 3.967826e-42
## 49 6.666929e-01 3.333065e-01 6.346580e-09 5.780184e-07
## 45 1.802690e-15 1.000000e+00 2.264407e-31 1.934003e-33
## 7  2.457768e-28 3.040106e-28 3.405253e-10 1.000000e+00
## 44 3.333657e-01 6.666343e-01 1.957835e-23 1.698048e-12
## 53 1.440901e-27 1.000000e+00 2.920693e-51 4.029107e-22
## 66 1.923752e-20 1.000000e+00 3.649458e-34 1.038548e-40
## 32 1.042215e-11 7.467211e-09 1.000000e+00 5.400177e-24
## 55 8.000045e-01 3.304870e-21 1.999955e-01 1.098789e-10
## 24 4.768671e-20 1.525592e-21 1.856171e-17 1.000000e+00
## 37 2.500126e-01 7.499874e-01 3.723388e-17 1.051388e-51
## 20 1.923752e-20 1.000000e+00 3.649458e-34 1.038548e-40
## 47 8.986263e-25 7.784246e-06 1.089586e-30 9.999922e-01
## 64 4.440992e-39 1.000000e+00 1.739343e-36 5.237728e-24
## 26 3.744915e-33 1.306904e-26 1.000000e+00 1.365958e-40
## 4  3.332076e-26 5.963304e-28 1.719905e-10 1.000000e+00
## 25 1.000000e+00 6.274892e-12 2.872428e-49 1.266573e-21
## 46 7.695106e-20 1.000000e+00 2.366127e-19 7.070453e-35
## 11 3.333657e-01 6.666343e-01 1.957835e-23 1.698048e-12
## 17 1.997211e-38 3.215746e-06 3.261941e-16 9.999968e-01
## 15 8.000045e-01 3.304870e-21 1.999955e-01 1.098789e-10
## 28 8.960292e-25 7.757659e-06 1.089024e-30 9.999922e-01
## 59 3.332076e-26 5.963304e-28 1.719905e-10 1.000000e+00
## 10 5.373964e-19 9.999999e-01 5.527768e-09 1.004250e-07
## 50 1.746150e-09 9.999977e-01 2.264895e-06 6.021695e-53
## 14 8.000045e-01 3.304870e-21 1.999955e-01 1.098789e-10
## 52 1.000000e+00 1.163975e-19 4.540984e-25 4.050387e-42
## 39 1.923752e-20 1.000000e+00 3.649458e-34 1.038548e-40
## 34 2.500126e-01 7.499874e-01 3.723388e-17 1.051388e-51
pacientes.prediccion.5neu.class <- apply( pacientes.prediccion.5neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.5neu.class
## 48  2 67 36 31 16 33 42 35 60 62 13 38  8 43 65 19 61 41 54 57 29 21  1 23 27 12 49 45  7 44 53 66 
##  2  2  1  2  2  4  2  1  2  2  2  2  1  2  1  4  2  1  3  3  3  2  2  1  1  4  1  1  2  4  2  2  2 
## 32 55 24 37 20 47 64 26  4 25 46 11 17 15 28 59 10 50 14 52 39 34 
##  3  1  4  2  2  4  2  3  4  1  2  2  4  1  4  4  2  2  1  1  2  2
table( pacientes.prediccion.5neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] )  # Lo vemos en forma de tabla.
##                                
## pacientes.prediccion.5neu.class  1  2  3  4
##                               1 12  1  1  0
##                               2  2 24  0  0
##                               3  0  0  5  0
##                               4  0  0  0 10
sum( diag( table( pacientes.prediccion.5neu.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.9272727

TEST

pacientes.prediccion.test.5neu <- predict( pacientes.5neu, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.5neu
##               1            2            3            4
## 3  5.373964e-19 9.999999e-01 5.527768e-09 1.004250e-07
## 5  1.923752e-20 1.000000e+00 3.649458e-34 1.038548e-40
## 6  3.333657e-01 6.666343e-01 1.957835e-23 1.698048e-12
## 9  2.449597e-47 1.974489e-10 5.201914e-21 1.000000e+00
## 18 6.666929e-01 3.333065e-01 6.346580e-09 5.780184e-07
## 22 8.000045e-01 3.304870e-21 1.999955e-01 1.098789e-10
## 30 8.873718e-14 5.935397e-02 9.406460e-01 3.583987e-51
## 40 3.333657e-01 6.666343e-01 1.957835e-23 1.698048e-12
## 51 6.666929e-01 3.333065e-01 6.346580e-09 5.780184e-07
## 56 3.613319e-15 9.822515e-08 2.142976e-47 9.999999e-01
## 58 4.134204e-26 7.472386e-28 1.814208e-10 1.000000e+00
## 63 1.415140e-27 1.000000e+00 2.711032e-51 4.150893e-22
pacientes.prediccion.test.5neu.class <- apply( pacientes.prediccion.test.5neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.5neu.class
##  3  5  6  9 18 22 30 40 51 56 58 63 
##  2  2  2  4  1  1  3  2  1  4  4  2
table( pacientes.prediccion.test.5neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##                                     
## pacientes.prediccion.test.5neu.class 1 2 3 4
##                                    1 0 1 1 1
##                                    2 1 2 1 1
##                                    3 0 1 0 0
##                                    4 2 1 0 0
sum( diag( table( pacientes.prediccion.test.5neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.1666667

5 NEURONAS

CON DECAY

SIN SOFTMAX

pacientes.5neu.decay <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5, decay=0.1)
## # weights:  149
## initial  value 56.911837 
## iter  10 value 30.132287
## iter  20 value 26.082664
## iter  30 value 25.243722
## iter  40 value 24.951000
## iter  50 value 24.704755
## iter  60 value 24.693736
## iter  70 value 24.691919
## iter  80 value 24.689550
## final  value 24.689541 
## converged

CON SOFTMAX

pacientes.5neu.decay <- nnet( matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], class.ind( matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) , size=5, softmax = T, decay = 0.05)
## # weights:  149
## initial  value 82.682578 
## iter  10 value 40.126556
## iter  20 value 31.104035
## iter  30 value 27.355246
## iter  40 value 25.506302
## iter  50 value 24.453048
## iter  60 value 22.975579
## iter  70 value 22.123225
## iter  80 value 21.917893
## iter  90 value 21.711419
## iter 100 value 21.691815
## final  value 21.691815 
## stopped after 100 iterations

pacientes.prediccion.5neu.decay <- predict( pacientes.5neu.decay, matriz.pacientes.datos.centscal[conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.5neu.decay # Vemos las probabilidades de pertenencia de cada valor
##               1            2            3            4
## 48 4.982356e-02 0.9354014314 0.0139150682 8.599452e-04
## 2  1.865562e-04 0.9996601699 0.0001478181 5.455838e-06
## 67 8.742580e-01 0.0913886621 0.0246439748 9.709322e-03
## 36 3.616064e-02 0.9344446232 0.0290526914 3.420477e-04
## 31 3.525427e-02 0.9610712125 0.0031386308 5.358885e-04
## 16 5.861355e-04 0.0088915628 0.0633692834 9.271530e-01
## 33 7.022812e-04 0.9988452493 0.0004438385 8.631042e-06
## 42 9.629420e-01 0.0338155015 0.0022400613 1.002446e-03
## 35 4.851834e-03 0.9381081123 0.0555751458 1.464908e-03
## 60 4.350687e-02 0.9551343884 0.0012964236 6.231475e-05
## 62 6.565125e-01 0.2002278764 0.0880617193 5.519795e-02
## 13 4.524452e-03 0.9919901611 0.0034340499 5.133660e-05
## 38 1.772684e-01 0.0232364603 0.7141263922 8.536875e-02
## 8  4.129315e-01 0.5747828208 0.0122165411 6.912108e-05
## 43 9.432614e-01 0.0275280912 0.0110374807 1.817300e-02
## 65 7.612988e-02 0.0112692206 0.0862296975 8.263712e-01
## 19 2.640802e-05 0.9490064583 0.0317490839 1.921805e-02
## 61 1.560495e-01 0.7821345578 0.0143933890 4.742252e-02
## 41 1.834899e-01 0.1822505525 0.5232743634 1.109852e-01
## 54 1.129143e-01 0.0079643017 0.7922502939 8.687113e-02
## 57 5.135708e-02 0.1470247413 0.7999141649 1.704018e-03
## 29 1.192337e-02 0.9842272381 0.0023981782 1.451215e-03
## 21 1.227844e-05 0.9908379428 0.0026280687 6.521710e-03
## 1  7.679436e-01 0.0358097757 0.1866654080 9.581201e-03
## 23 9.943347e-01 0.0031093861 0.0024482182 1.077430e-04
## 27 7.614457e-04 0.0060117095 0.0288792482 9.643476e-01
## 12 9.112197e-01 0.0847656964 0.0028284556 1.186112e-03
## 49 6.678153e-01 0.1569371212 0.0235542170 1.516933e-01
## 45 2.730347e-02 0.9450519690 0.0271609987 4.835623e-04
## 7  4.556264e-03 0.0197122221 0.0977116903 8.780198e-01
## 44 9.353245e-02 0.8144671013 0.0287884452 6.321201e-02
## 53 1.332954e-01 0.8122115336 0.0332350642 2.125803e-02
## 66 4.000169e-02 0.9110814699 0.0480037039 9.131397e-04
## 32 6.237805e-02 0.0870342685 0.6552744563 1.953132e-01
## 55 7.662324e-01 0.0223538882 0.1924793667 1.893439e-02
## 24 1.477586e-01 0.0405748165 0.0356101539 7.760565e-01
## 37 2.557284e-01 0.7358749543 0.0083512359 4.539694e-05
## 20 1.079821e-04 0.9885562225 0.0112125500 1.232453e-04
## 47 2.712800e-02 0.0321535439 0.1924803360 7.482381e-01
## 64 9.853576e-04 0.9499820743 0.0145144714 3.451810e-02
## 26 5.051510e-02 0.0754538089 0.8061794393 6.785165e-02
## 4  7.188344e-02 0.0149161016 0.0503248556 8.628756e-01
## 25 9.107547e-01 0.0490228669 0.0214988501 1.872354e-02
## 46 5.142855e-02 0.8489549877 0.0178567692 8.175969e-02
## 11 2.261145e-04 0.9814905138 0.0020929777 1.619039e-02
## 17 5.813353e-04 0.0736534711 0.0293918462 8.963733e-01
## 15 7.959846e-01 0.1531344729 0.0504031195 4.778251e-04
## 28 1.339204e-03 0.0483992325 0.0474147993 9.028468e-01
## 59 2.477328e-02 0.0078193524 0.0608704054 9.065370e-01
## 10 9.719003e-05 0.8940383351 0.0426625289 6.320195e-02
## 50 6.777813e-02 0.8102126770 0.1215875577 4.216331e-04
## 14 8.484573e-01 0.0001215897 0.1421065136 9.314619e-03
## 52 9.362707e-01 0.0351330849 0.0232408322 5.355350e-03
## 39 2.002328e-03 0.9963756774 0.0015608178 6.117664e-05
## 34 3.987117e-01 0.5868694539 0.0143345094 8.437700e-05
pacientes.prediccion.5neu.decay.class <- apply( pacientes.prediccion.5neu.decay, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.5neu.decay.class
## 48  2 67 36 31 16 33 42 35 60 62 13 38  8 43 65 19 61 41 54 57 29 21  1 23 27 12 49 45  7 44 53 66 
##  2  2  1  2  2  4  2  1  2  2  1  2  3  2  1  4  2  2  3  3  3  2  2  1  1  4  1  1  2  4  2  2  2 
## 32 55 24 37 20 47 64 26  4 25 46 11 17 15 28 59 10 50 14 52 39 34 
##  3  1  4  2  2  4  2  3  4  1  2  2  4  1  4  4  2  2  1  1  2  2
table( pacientes.prediccion.5neu.decay.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] )  # Lo vemos en forma de tabla.
##                                      
## pacientes.prediccion.5neu.decay.class  1  2  3  4
##                                     1 13  0  0  0
##                                     2  1 25  0  0
##                                     3  0  0  6  0
##                                     4  0  0  0 10
sum( diag( table( pacientes.prediccion.5neu.decay.class, matriz.pacientes.etiquetas[conjuntoEntrenamiento, 25] ) ) )/55 # Esta cuenta nos da el índice de acierto
## [1] 0.9818182

TEST

pacientes.prediccion.test.decay.5neu <- predict( pacientes.5neu.decay, matriz.pacientes.datos.centscal[-conjuntoEntrenamiento, 1:24], type="raw" )
pacientes.prediccion.test.decay.5neu
##               1          2            3            4
## 3  0.0029729828 0.87757160 0.1019377732 1.751764e-02
## 5  0.0006966971 0.99888659 0.0004056762 1.103346e-05
## 6  0.0002474626 0.79345602 0.0605650407 1.457315e-01
## 9  0.0142699241 0.29873653 0.3148387346 3.721548e-01
## 18 0.9521129229 0.04563514 0.0018044247 4.475094e-04
## 22 0.7959845826 0.15313447 0.0504031195 4.778251e-04
## 30 0.1951062895 0.70166135 0.0986405003 4.591856e-03
## 40 0.5084243380 0.45048413 0.0236448644 1.744667e-02
## 51 0.8216640459 0.17396996 0.0029891156 1.376876e-03
## 56 0.0143462623 0.01590657 0.0144768752 9.552703e-01
## 58 0.0247027246 0.30208165 0.1804445257 4.927711e-01
## 63 0.8489226818 0.11801216 0.0329122972 1.528658e-04
pacientes.prediccion.test.decay.5neu.class <- apply( pacientes.prediccion.test.decay.5neu, MARGIN=1, FUN='which.is.max')
pacientes.prediccion.test.decay.5neu.class
##  3  5  6  9 18 22 30 40 51 56 58 63 
##  2  2  2  4  1  1  2  1  1  4  4  1
table( pacientes.prediccion.test.decay.5neu.class , matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] )
##                                           
## pacientes.prediccion.test.decay.5neu.class 1 2 3 4
##                                          1 1 1 2 1
##                                          2 0 3 0 1
##                                          4 2 1 0 0
sum( diag( table( pacientes.prediccion.test.decay.5neu.class, matriz.pacientes.etiquetas[-conjuntoEntrenamiento, 25] ) ) )/12
## [1] 0.3333333

Obtención de Resultados de Perceptrón

Importo los datos:

dataset.resultados <- read.csv2("C:/Users/jorge/Desktop/Documentos Clase/Universidad/4ºCarrera/1er Cuatrimestre/Inteligencia Artificial/Trabajo Fin de Asignatura/Resultados.txt")

Ahora voy a sacar un gráfico donde comparo los resultados.

#install.packages("plotly")
library("plotly")
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
tipos = dataset.resultados[, 1]
real = dataset.resultados[, 2]
practico = dataset.resultados[, 3]

p<- plot_ly(dataset.resultados, x = ~tipos, y = ~real, type = 'bar', name = 'Real') %>% add_trace(y = ~practico, name = 'Práctico') %>% layout(yaxis = list(title = 'Porcentaje'), barmode = 'group')

p 
#Mostramos el gráfico interactivo

KNN

#install.packages("class")
library("class")

# Para hacer la predicción con knn, voy a coger los grupos de una manera distinta:

conjuntoEntrenamiento = matriz.pacientes.datos.centscal[1:55, 1:24]
conjuntoTest = matriz.pacientes.datos.centscal[56:67, 1:24]
# Utilizo por supuesto la matriz de centrado y escalado

etiquetasEntrenamiento = matriz.pacientes.etiquetas[1:55, 25]
etiquetasTest = matriz.pacientes.etiquetas[56:67, 25]
conjuntoEntrenamiento
conjuntoTest
etiquetasEntrenamiento
etiquetasTest

Para K = 8…

# K = 8

prediccion.knn.8 <- knn(train = conjuntoEntrenamiento, test = conjuntoTest, cl = etiquetasEntrenamiento, k = 8)
prediccion.knn.8
##  [1] 1 2 2 1 2 1 2 2 2 1 2 2
## Levels: 1 2 3 4

Sacamos crosstable:

#install.packages("gmodels")
library("gmodels")
CrossTable(x = etiquetasTest , y = prediccion.knn.8, prop.chisq = FALSE)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  12 
## 
##  
##               | prediccion.knn.8 
## etiquetasTest |         1 |         2 | Row Total | 
## --------------|-----------|-----------|-----------|
##             1 |         1 |         3 |         4 | 
##               |     0.250 |     0.750 |     0.333 | 
##               |     0.250 |     0.375 |           | 
##               |     0.083 |     0.250 |           | 
## --------------|-----------|-----------|-----------|
##             2 |         1 |         3 |         4 | 
##               |     0.250 |     0.750 |     0.333 | 
##               |     0.250 |     0.375 |           | 
##               |     0.083 |     0.250 |           | 
## --------------|-----------|-----------|-----------|
##             3 |         0 |         2 |         2 | 
##               |     0.000 |     1.000 |     0.167 | 
##               |     0.000 |     0.250 |           | 
##               |     0.000 |     0.167 |           | 
## --------------|-----------|-----------|-----------|
##             4 |         2 |         0 |         2 | 
##               |     1.000 |     0.000 |     0.167 | 
##               |     0.500 |     0.000 |           | 
##               |     0.167 |     0.000 |           | 
## --------------|-----------|-----------|-----------|
##  Column Total |         4 |         8 |        12 | 
##               |     0.333 |     0.667 |           | 
## --------------|-----------|-----------|-----------|
## 
## 

Para K = 6

# K = 6

prediccion.knn.6 <- knn(train = conjuntoEntrenamiento, test = conjuntoTest, cl = etiquetasEntrenamiento, k = 6)
prediccion.knn.6
##  [1] 1 2 2 1 2 1 2 2 2 1 2 2
## Levels: 1 2 3 4
CrossTable(x = etiquetasTest , y = prediccion.knn.6, prop.chisq = FALSE)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  12 
## 
##  
##               | prediccion.knn.6 
## etiquetasTest |         1 |         2 | Row Total | 
## --------------|-----------|-----------|-----------|
##             1 |         1 |         3 |         4 | 
##               |     0.250 |     0.750 |     0.333 | 
##               |     0.250 |     0.375 |           | 
##               |     0.083 |     0.250 |           | 
## --------------|-----------|-----------|-----------|
##             2 |         1 |         3 |         4 | 
##               |     0.250 |     0.750 |     0.333 | 
##               |     0.250 |     0.375 |           | 
##               |     0.083 |     0.250 |           | 
## --------------|-----------|-----------|-----------|
##             3 |         0 |         2 |         2 | 
##               |     0.000 |     1.000 |     0.167 | 
##               |     0.000 |     0.250 |           | 
##               |     0.000 |     0.167 |           | 
## --------------|-----------|-----------|-----------|
##             4 |         2 |         0 |         2 | 
##               |     1.000 |     0.000 |     0.167 | 
##               |     0.500 |     0.000 |           | 
##               |     0.167 |     0.000 |           | 
## --------------|-----------|-----------|-----------|
##  Column Total |         4 |         8 |        12 | 
##               |     0.333 |     0.667 |           | 
## --------------|-----------|-----------|-----------|
## 
## 

Para k = 10

# K = 10

prediccion.knn.10 <- knn(train = conjuntoEntrenamiento, test = conjuntoTest, cl = etiquetasEntrenamiento, k = 10)
prediccion.knn.10
##  [1] 1 2 2 1 2 1 2 2 4 1 2 2
## Levels: 1 2 3 4
CrossTable(x = etiquetasTest , y = prediccion.knn.10, prop.chisq = FALSE)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  12 
## 
##  
##               | prediccion.knn.10 
## etiquetasTest |         1 |         2 |         4 | Row Total | 
## --------------|-----------|-----------|-----------|-----------|
##             1 |         1 |         3 |         0 |         4 | 
##               |     0.250 |     0.750 |     0.000 |     0.333 | 
##               |     0.250 |     0.429 |     0.000 |           | 
##               |     0.083 |     0.250 |     0.000 |           | 
## --------------|-----------|-----------|-----------|-----------|
##             2 |         1 |         2 |         1 |         4 | 
##               |     0.250 |     0.500 |     0.250 |     0.333 | 
##               |     0.250 |     0.286 |     1.000 |           | 
##               |     0.083 |     0.167 |     0.083 |           | 
## --------------|-----------|-----------|-----------|-----------|
##             3 |         0 |         2 |         0 |         2 | 
##               |     0.000 |     1.000 |     0.000 |     0.167 | 
##               |     0.000 |     0.286 |     0.000 |           | 
##               |     0.000 |     0.167 |     0.000 |           | 
## --------------|-----------|-----------|-----------|-----------|
##             4 |         2 |         0 |         0 |         2 | 
##               |     1.000 |     0.000 |     0.000 |     0.167 | 
##               |     0.500 |     0.000 |     0.000 |           | 
##               |     0.167 |     0.000 |     0.000 |           | 
## --------------|-----------|-----------|-----------|-----------|
##  Column Total |         4 |         7 |         1 |        12 | 
##               |     0.333 |     0.583 |     0.083 |           | 
## --------------|-----------|-----------|-----------|-----------|
## 
## 

Como se puede observar, la mejor predicción la hemos hecho con K = 8

Random Forest

Ahora voy a implementar una solución mediante Random Forest:

Lo primero que hacemos es importar el paquete de Random Forest

#install.packages("randomForest")
library(randomForest)
## Warning: package 'randomForest' was built under R version 3.5.2
## randomForest 4.6-14
## Type rfNews() to see new features/changes/bug fixes.
## 
## Attaching package: 'randomForest'
## The following object is masked from 'package:ggplot2':
## 
##     margin

Una vez instalado e importado, lo que tengo que hacer es crear el Random Forest, y ejecutarlo…

model <- randomForest(grupo ~ ., data = dataset[2:26], importance = TRUE)
## Warning in randomForest.default(m, y, ...): The response has five or fewer unique values. Are you
## sure you want to do regression?
model
## 
## Call:
##  randomForest(formula = grupo ~ ., data = dataset[2:26], importance = TRUE) 
##                Type of random forest: regression
##                      Number of trees: 500
## No. of variables tried at each split: 8
## 
##           Mean of squared residuals: 1.31522
##                     % Var explained: -26.53

Ahora lo voy a hacer con 10 fold X Validation:

result <- rfcv(dataset[2:26], dataset$grupo, cv.fold=10)
## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, , drop = FALSE], trainy[idx != : The response has
## five or fewer unique values. Are you sure you want to do regression?
## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?

## Warning in randomForest.default(trainx[idx != i, imp.idx, drop = FALSE], : The response has five or
## fewer unique values. Are you sure you want to do regression?
result
## $n.var
## [1] 25 12  6  3  1
## 
## $error.cv
##           25           12            6            3            1 
## 3.212178e-01 2.464022e-01 1.886628e-01 2.732821e-01 2.388060e-07 
## 
## $predicted
## $predicted$`25`
##  [1] 1.982331 1.887672 2.011345 3.281646 1.962549 3.490236 2.911979 1.609840 2.090730 2.078963
## [11] 2.034833 1.978881 1.858968 2.224936 1.969202 3.355040 2.908772 1.917287 2.102230 1.986095
## [21] 2.172444 2.707646 1.531603 2.806306 1.683873 2.601354 2.915512 2.916859 2.216319 1.963463
## [31] 1.840388 3.194363 1.858743 1.873931 2.092473 1.842767 1.979492 2.817315 1.888942 1.457830
## [41] 2.800290 1.573426 1.345242 1.887984 1.961183 1.917217 3.152377 1.914741 1.792954 1.985643
## [51] 2.708894 1.599663 1.958620 3.072799 1.775754 1.669558 2.754246 1.642351 3.347193 2.003223
## [61] 1.789780 1.814869 2.794622 2.261544 3.053449 1.953018 1.595713
## 
## $predicted$`12`
##  [1] 1.878752 1.974910 1.924424 3.497769 2.029065 3.541117 3.105299 1.539830 2.157784 2.061076
## [11] 1.793065 1.839139 1.900870 2.308300 1.852158 3.537069 3.027531 1.962803 2.116736 2.009683
## [21] 2.128716 2.646602 1.553078 2.819199 1.603565 2.750723 3.218707 2.987121 2.207621 1.924424
## [31] 1.960074 3.177790 1.910811 1.916075 1.988559 1.861179 1.861346 2.922513 1.962727 1.436139
## [41] 3.059703 1.360124 1.273276 1.774361 1.972473 1.924124 3.414326 1.991702 1.612870 1.854008
## [51] 2.965503 1.554860 2.027964 3.103892 1.634960 1.456246 2.755071 1.681068 3.432768 2.096877
## [61] 1.747576 1.774956 2.884437 2.225156 3.234190 1.887375 1.591628
## 
## $predicted$`6`
##  [1] 1.780928 1.949694 1.995961 3.411777 2.054857 3.700776 3.201064 1.446015 2.035618 2.090764
## [11] 1.930786 1.747830 1.905630 2.276608 1.664145 3.549580 2.877045 1.987615 1.978727 2.007160
## [21] 2.114558 2.756875 1.401307 2.770878 1.430317 2.880475 3.198937 3.591060 2.032583 1.995961
## [31] 1.940852 3.185933 1.984888 1.931969 2.004611 1.922794 1.881340 2.958763 2.041140 1.247460
## [41] 3.044415 1.283634 1.232441 1.694318 2.033067 1.795944 3.544349 1.945015 1.451720 1.863095
## [51] 2.962053 1.398037 1.826146 3.278698 1.473558 1.287362 2.787567 1.627074 3.607956 2.005047
## [61] 1.734937 1.456036 2.871045 2.142339 3.555325 2.015482 1.539971
## 
## $predicted$`3`
##  [1] 1.639628 1.958771 2.072501 3.309298 2.026765 3.376972 3.282689 1.688377 2.026765 2.081616
## [11] 1.991421 1.671378 1.949608 2.477221 1.671378 3.269030 3.171519 2.010797 2.048816 2.048816
## [21] 2.081616 2.609703 1.635886 2.678457 1.403065 2.928247 2.989495 3.226868 2.010797 2.072501
## [31] 1.881446 3.023736 1.994177 2.026765 2.016529 1.993378 1.918519 2.843095 2.027447 1.588013
## [41] 2.995247 1.690797 1.648125 1.907468 2.064008 2.017040 3.197651 1.979350 1.737745 1.892148
## [51] 3.197651 1.737745 1.892148 3.129420 1.737745 1.671378 2.755152 1.769461 3.197651 2.027745
## [61] 1.907468 1.720233 2.640787 2.079461 3.318815 1.945774 1.690797
## 
## $predicted$`1`
##  [1] 1.000 2.000 2.000 4.000 2.000 4.000 4.000 1.000 2.000 2.000 2.000 1.000 2.000 1.000 1.000 4.000
## [17] 4.000 2.000 2.000 2.000 2.000 2.998 1.000 4.000 1.000 3.000 4.000 4.000 2.000 2.000 2.000 3.000
## [33] 2.000 2.000 2.000 2.000 2.000 2.998 2.000 1.000 2.998 1.000 1.000 2.000 2.000 2.000 4.000 2.000
## [49] 1.000 2.000 4.000 1.000 2.000 2.998 1.000 1.000 3.000 1.000 4.000 2.000 2.000 1.000 3.000 2.000
## [65] 4.000 2.000 1.000

Podemos ver el error, bajo la variable $error.cv, y podemos ver las predicciones que se han hecho para cada una de las n.var.

SVM de Kernel Lineal

Lo bueno que tiene SVM es que es muy robusto frente a la dimensión, por lo que deberíamos de obtener a priori buenos resultados con este método.

Lo primero que hay que hacer es importar la librería…

#install.packages("e1071")
library("e1071")
## Warning: package 'e1071' was built under R version 3.5.2

Con este método no necesito tener un conjunto de entrenaminento y otro de test, por lo que sigo adelante.

Ahora que hemos instalado la librería, vamos a crear el SVM:

modelo_svm <- svm(grupo ~ ., data=dataset[2:26], kernel="linear")
summary(modelo_svm)
## 
## Call:
## svm(formula = grupo ~ ., data = dataset[2:26], kernel = "linear")
## 
## 
## Parameters:
##    SVM-Type:  eps-regression 
##  SVM-Kernel:  linear 
##        cost:  1 
##       gamma:  0.04166667 
##     epsilon:  0.1 
## 
## 
## Number of Support Vectors:  64

Ahora que tenemos creado este primer modelo, toca predecir:

prediccion <- predict(modelo_svm,dataset[,2:25])
prediccion
##        1        2        3        4        5        6        7        8        9       10       11 
## 2.710785 1.167141 2.103294 2.272653 1.921987 2.951614 2.215446 1.903501 2.343303 2.364138 1.624035 
##       12       13       14       15       16       17       18       19       20       21       22 
## 1.264225 1.134063 3.102210 1.472399 3.897730 2.237491 1.897509 2.142401 1.897167 2.651879 1.472399 
##       23       24       25       26       27       28       29       30       31       32       33 
## 1.102637 1.498541 1.595378 2.586326 3.896878 2.912379 1.897073 2.064304 1.392893 2.897015 2.102379 
##       34       35       36       37       38       39       40       41       42       43       44 
## 1.897257 2.712875 1.764464 1.925354 2.268604 1.897013 1.237698 1.952647 1.724457 2.010257 2.102934 
##       45       46       47       48       49       50       51       52       53       54       55 
## 2.102424 2.102300 2.865796 2.103005 2.080632 2.155359 1.844763 2.016170 1.897797 2.896991 2.171207 
##       56       57       58       59       60       61       62       63       64       65       66 
## 2.075540 2.088427 1.103007 2.142982 2.187305 2.102484 2.155098 2.270547 2.102423 3.897624 2.103058 
##       67 
## 2.053638

El problema que tenemos con estas predicciones es que están siendo contínuas, y no discretas, por lo que las voy a discretizar redondeando:

prediccion <- round(prediccion, digits = 0)
prediccion
##  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 
##  3  1  2  2  2  3  2  2  2  2  2  1  1  3  1  4  2  2  2  2  3  1  1  1  2  3  4  3  2  2  1  3  2 
## 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 
##  2  3  2  2  2  2  1  2  2  2  2  2  2  3  2  2  2  2  2  2  3  2  2  2  1  2  2  2  2  2  2  4  2 
## 67 
##  2

Ahora que hemos predicho, tenemos que sacar la matriz de confusión:

matriz.conf <- table(prediccion, dataset[,26])
matriz.conf
##           
## prediccion  1  2  3  4
##          1  5  3  1  1
##          2 10 25  4  5
##          3  2  2  3  3
##          4  0  0  0  3
sum(diag(matriz.conf))/67
## [1] 0.5373134

Obtenemos un porcentaje de acierto medio, pero esto es sin tener en cuenta que los pacientes del grupo 2 pueden pertenecer al 1, lo cual suma alrededor de 10 pacientes más, por lo que obtendríamos valores mucho más altos que rondarían el 65-70% de acierto.

SVM de Kernel RBF

modelo_svm.radial <- svm(grupo ~ ., data=dataset[2:26], kernel="radial")
summary(modelo_svm.radial)
## 
## Call:
## svm(formula = grupo ~ ., data = dataset[2:26], kernel = "radial")
## 
## 
## Parameters:
##    SVM-Type:  eps-regression 
##  SVM-Kernel:  radial 
##        cost:  1 
##       gamma:  0.04166667 
##     epsilon:  0.1 
## 
## 
## Number of Support Vectors:  60

Ahora que tenemos creado este primer modelo, toca predecir:

prediccion.radial <- predict(modelo_svm.radial,dataset[,2:25])
prediccion.radial
##        1        2        3        4        5        6        7        8        9       10       11 
## 1.549973 1.897491 2.102992 2.931869 1.958610 2.933492 2.460079 1.968849 2.102839 2.102609 2.102858 
##       12       13       14       15       16       17       18       19       20       21       22 
## 1.834806 1.897158 1.792309 2.081453 3.345387 2.644334 1.896957 2.102818 2.101751 2.102659 2.081453 
##       23       24       25       26       27       28       29       30       31       32       33 
## 1.102789 2.171444 1.688974 2.247323 3.098435 2.310026 2.102645 2.090946 1.897066 2.757770 2.102934 
##       34       35       36       37       38       39       40       41       42       43       44 
## 1.935061 2.103190 1.897447 2.078152 2.427070 1.897235 1.396473 2.724358 1.577114 1.558528 1.911562 
##       45       46       47       48       49       50       51       52       53       54       55 
## 2.102722 2.093837 2.558446 2.102649 1.964595 2.102263 1.784159 1.755280 2.102747 2.897155 1.865630 
##       56       57       58       59       60       61       62       63       64       65       66 
## 1.404453 2.647560 1.341993 2.806776 2.103103 2.102609 1.945673 2.749015 2.102654 3.127086 2.102353 
##       67 
## 1.482761

El problema que tenemos con estas predicciones es que están siendo contínuas, y no discretas, por lo que las voy a discretizar redondeando:

prediccion.radial <- round(prediccion.radial, digits = 0)
prediccion.radial
##  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 
##  2  2  2  3  2  3  2  2  2  2  2  2  2  2  2  3  3  2  2  2  2  2  1  2  2  2  3  2  2  2  2  3  2 
## 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 
##  2  2  2  2  2  2  1  3  2  2  2  2  2  3  2  2  2  2  2  2  3  2  1  3  1  3  2  2  2  3  2  3  2 
## 67 
##  1

Ahora que hemos predicho, tenemos que sacar la matriz de confusión:

matriz.conf.radial <- table(prediccion.radial, dataset[,26])
matriz.conf.radial
##                  
## prediccion.radial  1  2  3  4
##                 1  5  0  0  0
##                 2 12 30  3  4
##                 3  0  0  5  8
sum(diag(matriz.conf.radial))/67
## [1] 0.5970149

Obtenemos un acierto del 60%, al que hay que sumar otros 12 pacientes. ### Si añadimos estos pacientes, nos encontramos con un acierto del 77% Por lo tanto, SVM de Kernel radial es una buena técnica para la predicción en este problema.


Ahora pasamos a los modelos de inteligencia artificial no supervisados:

Modelos de inteligencia artificial no supervisados

El primer modelo de inteligencia artificial no supervisado que voy a usar es un modelo de clustering llamado Dendrograma.

Dendrograma

Para esto, lo que voy a hacer es dividirlo en 4 clusters, coincidiendo con los 4 grupos de trastornos que tengo.

#install.packages("ape")
library(ape)
## Warning: package 'ape' was built under R version 3.5.2
dd <- dist(scale(dataset[,2:25]), method = "euclidean") #Nos basamos en la distancia euclídea
hier.clust <- hclust(dd, method = "ward.D2")
colores.dendrograma = c("red", "orange", "green", "black")
cluster.4 = cutree(hier.clust, 4)
plot(as.phylo(hier.clust), type = "fan", tip.color = colores.dendrograma[cluster.4], label.offset = 0.3, cex = 0.8)

Como vemos, estamos obteniendo el indentificador de cada paciente en el dendrograma, donde los pacientes que mas se parecen estarán más juntos, mientras que los que menos se parecen estarán más separados. Es interesante analizar como los pacientes verdes y los naranjas surgen de la misma salida del centro, cosa que no ocurre con los rojos y los negros, lo cual quiere decir que algo tienen en común estos dos tipos de casos.

Ahora voy a hacer el mismo dendrograma pero con el DataSet de centrado y escalado, de tal manera que veamos a ver si hay diferencias:

dd <- dist(scale(matriz.pacientes.datos.centscal), method = "euclidean") #Nos basamos en la distancia euclídea
hier.clust <- hclust(dd, method = "ward.D2")
colores.dendrograma = c("red", "orange", "green", "black")
cluster.4 = cutree(hier.clust, 4)
plot(as.phylo(hier.clust), type = "fan", tip.color = colores.dendrograma[cluster.4], label.offset = 0.3, cex = 0.8)

Si lo comparamos, vemos que hemos obtenido exactamente el mismo resultado, por lo que en este caso el centrado y escalado no es necesario.

Vamos a analizar algunos pacientes aleatoriamente para ver si ha acertado, o al menos si se ha aproximado:

Paciente 1: Analizado - Rojo ——— Real: 1 Paciente 2: Analizado - Naranja —— Real: 2 Paciente 3: Analizado - Naranja —— Real: 2 Paciente 4: Analizado - Verde ——– Real: 4 Paciente 5: Analizado - Naranja —— Real: 2 Paciente 27: Analizado - Negro ——- Real: 4

Es decir, a la vista de estos resultados, podemos concluir que el grupo 1 es el de los pacientes en rojo, el grupo 2 es el de los pacientes en naranja, y luego entre el grupo 3 y el grupo 4 hay dudas, pero teniendo varios pacientes tanto del grupo 3 como del grupo 4 en nuestro DataSet parece ser que algo de error ha cometido.

K-Means

El algoritmo KMeans en principio no es el algoritmo más adecuado para este trabajo, ya que se basa en círculos para la clasificación de los individuos, cuando en principio en mis datos esto no es así. De todas formas, voy a clasificar a los pacientes siguiendo este algoritmo para comprobar la eficacia que tiene sobre mi problema:

set.seed(76964057) #Seed para reproducibilidad
k <-kmeans(dataset[,2:25], centers=4) #Creo 4 clusters
k$centers #Muestro los centros
##       edad       sex rel_ctxo_rel_mala rel_ctxo_trauma rel_ctxo_buena    ed_perm   ed_norm
## 1 16.61111 0.2777778        0.05555556       0.3888889      0.5555556 0.61111111 0.1666667
## 2 23.82609 0.1739130        0.08695652       0.3043478      0.6086957 0.08695652 0.6956522
## 3 30.94118 0.1176471        0.17647059       0.3529412      0.4705882 0.11764706 0.6470588
## 4 44.44444 0.3333333        0.33333333       0.4444444      0.2222222 0.44444444 0.3333333
##     ed_estr  resil_ba   resil_me  resil_al   pen_dic    gen_ex      etiq   fil_men   max_min
## 1 0.2222222 0.9444444 0.05555556 0.0000000 0.8333333 0.9444444 0.7777778 0.7222222 0.9444444
## 2 0.2173913 0.4782609 0.52173913 0.0000000 0.9130435 0.9565217 1.0000000 0.7826087 0.9565217
## 3 0.2352941 0.4705882 0.52941176 0.0000000 0.9411765 1.0000000 0.5882353 0.8235294 1.0000000
## 4 0.2222222 0.2222222 0.66666667 0.1111111 0.8888889 0.8888889 0.3333333 0.8888889 1.0000000
##    conc_arb  pseu_res       deb   raz_emo     inhib      asert     agres    impuls
## 1 0.9444444 0.2222222 0.7777778 0.8333333 0.6666667 0.00000000 0.3333333 0.5000000
## 2 1.0000000 0.6956522 1.0000000 0.9130435 0.7826087 0.08695652 0.1304348 0.5652174
## 3 1.0000000 0.6470588 1.0000000 0.7058824 0.5294118 0.23529412 0.2352941 0.7647059
## 4 1.0000000 0.3333333 1.0000000 0.5555556 0.5555556 0.33333333 0.1111111 0.6666667
table(k$cluster) #Número de puntos en cada cluster
## 
##  1  2  3  4 
## 18 23 17  9

Interpretando estos resultados, obtenemos:

El cluster 1 destaca por sexo más hacia masculino que otros, una relación contexto ciertamente buena, una educación permisiva, una resiliencia baja, maximización y minimización, razonamiento emocional, cierta inhibición y poca agresividad.

El cluster 2 destaca por una edad mayor, es el cluster con mejor relación con el contexto, y suelen tener las personas de este cluster una educación normal. Destaca por una resiliencia media, pensamiento dicotómico, generalización excesiva, etiquetado, conclusiones arbitrarias, deberías, razonamiento emocional e inhibición.

El cluster número 3 destaca por tener una edad aún más elevada, más ratio de personas del sexo femenino que ningún otro cluster, y tienen una relación con el contexto bastante variable. La educación de estas personas es principalmente normal, con una resiliencia que puede ser tanto baja como media. Destacan por el pensamiento dicotómico, generalización excesiva, poco etiquetado, maximización y minimización, filtro mental, conclusiones arbitrarias, pseudoresponsabilidad, deberías, y suelen ser bastante inhibidos e impulsivos.

Finalmente, el cluster 4 destaca por ser el que tiene la edad más elevada y el ratio de sexo más masculino. La relación con el contexto de estos individuos clasificados en este grupo es principalmente de trauma, aunque también hay buenas y malas. La educación de estos individuos es principalmente permisiva, y la resiliciencia tiende a media. Destacan por la poca etiquetación que hacen, pero un gran fitro mental, conclusiones arbitrarias, poca pseudo-responsabilidad, muchos deberías, poco razonamiento emocional, y son principalmente inhibidos e impulsivos.

Finalmente, podemos ver como ha introducido a 18 individuos en el cluster 1, 23 en el cluster 2, 17 en el cluster 3 y 9 en el cluster 4.